home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Oberon⁄F™ 1.1 / Obx / Mod / Graphs (.txt) < prev    next >
Encoding:
Oberon Document  |  1996-01-05  |  6.6 KB  |  211 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. Helvetica
  17. Helvetica
  18. MODULE ObxGraphs;
  19.     IMPORT
  20.         Domains, Stores, Ports, Models, Views, Controllers, Properties, TextModels, TextViews, TextMappers;
  21.     CONST minVersion = 0; maxVersion = 0;
  22.     TYPE
  23.         Value = POINTER TO RECORD
  24.             next: Value;
  25.             val: LONGINT
  26.         END;
  27.         Model = POINTER TO RECORD (Models.ModelDesc)
  28.             values: Value
  29.         END;
  30.         View = POINTER TO RECORD (Views.ViewDesc)
  31.             model: Model
  32.         END;
  33.         ModelOp = POINTER TO RECORD (Domains.OperationDesc)
  34.             model: Model;
  35.             values: Value
  36.         END;
  37.     PROCEDURE (op: ModelOp) Do;
  38.         VAR v: Value; msg: Models.UpdateMsg;
  39.     BEGIN
  40.         v := op.model.values; op.model.values := op.values; op.values := v;    (* swap *)
  41.         Models.Broadcast(op.model, msg)
  42.     END Do;
  43.     PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
  44.         VAR thisVersion: SHORTINT; n: INTEGER; v, last: Value;
  45.     BEGIN
  46.         m.Internalize^(rd);
  47.         IF ~rd.cancelled THEN
  48.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  49.             IF ~rd.cancelled THEN
  50.                 last := NIL;
  51.                 rd.ReadInt(n);    (* read number of values *)
  52.                 WHILE n # 0 DO
  53.                     NEW(v); rd.ReadLInt(v.val);
  54.                     IF last = NIL THEN m.values := v ELSE last.next := v END;    (* append value *)
  55.                     last := v;
  56.                     DEC(n)
  57.                 END
  58.             END
  59.         END
  60.     END Internalize;
  61.     PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
  62.         VAR v: Value; n: INTEGER;
  63.     BEGIN
  64.         m.Externalize^(wr);
  65.         wr.WriteVersion(maxVersion);
  66.         v := m.values; n := 0; WHILE v # NIL DO INC(n); v := v.next END;
  67.         wr.WriteInt(n);    (* write number of values *)
  68.         v := m.values; WHILE v # NIL DO wr.WriteLInt(v.val); v := v.next END
  69.     END Externalize;
  70.     PROCEDURE (m: Model) CopyAllFrom (source: Models.Model);
  71.     BEGIN
  72.         m.values := source(Model).values    (* values are immutable and thus can be shared *)
  73.     END CopyAllFrom;
  74.     PROCEDURE (m: Model) InitFrom (source: Models.Model);    (* do nothing *)
  75.     END InitFrom;
  76.     PROCEDURE (m: Model) SetValues (v: Value);
  77.         VAR op: ModelOp;
  78.     BEGIN
  79.         NEW(op); op.model := m; op.values := v;
  80.         Models.Do(m, "Set Values", op)
  81.     END SetValues;
  82.     PROCEDURE OpenData (v: View);
  83.         VAR t: TextModels.Model; f: TextMappers.Formatter; h: Value;
  84.     BEGIN
  85.         t := TextModels.dir.New();
  86.         f.ConnectTo(t);
  87.         h := v.model.values;
  88.         WHILE h # NIL DO
  89.             f.WriteInt(h.val); f.WriteLn;
  90.             h := h.next
  91.         END;
  92.         Views.OpenAux(TextViews.dir.New(t), "Values")
  93.     END OpenData;
  94.     PROCEDURE DropData (t: TextModels.Model; v: View);
  95.         VAR s: TextMappers.Scanner; first, last, h: Value;
  96.     BEGIN
  97.         s.ConnectTo(t);
  98.         s.Scan;
  99.         WHILE s.type = TextMappers.int DO
  100.             NEW(h); h.val := s.int;
  101.             IF last = NIL THEN first := h ELSE last.next := h END;
  102.             last := h;
  103.             s.Scan
  104.         END;
  105.         v.model.SetValues(first)
  106.     END DropData;
  107.     PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  108.         VAR thisVersion: SHORTINT; s: Stores.Store;
  109.     BEGIN
  110.         v.Internalize^(rd);
  111.         IF ~rd.cancelled THEN
  112.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  113.             IF ~rd.cancelled THEN
  114.                 rd.ReadStore(s); ASSERT(s # NIL, 100);
  115.                 IF s IS Model THEN
  116.                     v.InitModel(s(Model))
  117.                 ELSE
  118.                     rd.TurnIntoAlien(Stores.alienComponent)
  119.                 END
  120.             END
  121.         END
  122.     END Internalize;
  123.     PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  124.     BEGIN
  125.         v.Externalize^(wr);
  126.         wr.WriteVersion(maxVersion);
  127.         wr.WriteStore(v.model)
  128.     END Externalize;
  129.     PROCEDURE (v: View) InitModel (m: Models.Model);
  130.     BEGIN
  131.         v.model := m(Model)
  132.     END InitModel;
  133.     PROCEDURE (v: View) ThisModel (): Models.Model;
  134.     BEGIN
  135.         RETURN v.model
  136.     END ThisModel;
  137.     PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  138.         VAR h: Value; n: INTEGER; width, height, d, x: LONGINT;
  139.     BEGIN
  140.         h := v.model.values; n := 0; WHILE h # NIL DO INC(n); h := h.next END;    (* count values *)
  141.         IF n > 0 THEN
  142.             v.context.GetSize(width, height);
  143.             d := width DIV n; x := 0;
  144.             h := v.model.values;
  145.             WHILE h # NIL DO
  146.                 f.DrawRect(x, height - h.val * Ports.mm, x + d, height, Ports.fill, Ports.grey25);
  147.                 h := h.next; INC(x, d)
  148.             END
  149.         END
  150.     END Restore;
  151.     PROCEDURE (v: View) HandleModelMsg (VAR msg: Models.Message);
  152.     BEGIN
  153.         WITH msg: Models.UpdateMsg DO
  154.             Views.Update(v, Views.keepFrames)
  155.         ELSE
  156.         END
  157.     END HandleModelMsg;
  158.     PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage;
  159.                                                                 VAR focus: Views.View);
  160.         VAR x, y, w, h: LONGINT; modifiers: SET; isDown: BOOLEAN;
  161.     BEGIN
  162.         WITH msg: Controllers.TrackMsg DO
  163.             REPEAT f.Input(x, y, modifiers, isDown) UNTIL ~isDown;
  164.             v.context.GetSize(w, h);
  165.             IF (x >= 0) & (y >= 0) & (x < w) & (y < h) THEN OpenData(v) END
  166.         | msg: Controllers.PollDropMsg DO
  167.             IF msg.view IS TextViews.View THEN msg.dest := f (* enable drop target feedback *) END
  168.         | msg: Controllers.DropMsg DO
  169.             IF msg.view IS TextViews.View THEN
  170.                 DropData(msg.view(TextViews.View).ThisModel(), v)    (* interpret dropped text *)
  171.             END
  172.         ELSE
  173.         END
  174.     END HandleCtrlMsg;
  175.     PROCEDURE (v: View) HandlePropMsg (VAR p: Properties.Message);
  176.         CONST min = 10 * Ports.mm; max = 160 * Ports.mm; pref = 90 * Ports.mm;
  177.     BEGIN
  178.         WITH p: Properties.SizePref DO    (* prevent illegal sizes *)
  179.             IF p.w = Views.undefined THEN p.w := pref
  180.             ELSIF p.w < min THEN p.w := min
  181.             ELSIF p.w > max THEN p.w := max
  182.             END;
  183.             IF p.h = Views.undefined THEN p.h := pref
  184.             ELSIF p.h < min THEN p.h := min
  185.             ELSIF p.h > max THEN p.h := max
  186.             END
  187.         | p: Properties.FocusPref DO
  188.             p.atLocation := FALSE; p.hotFocus := TRUE; p.setFocus := FALSE; p.selectOnFocus := FALSE
  189.         ELSE
  190.         END
  191.     END HandlePropMsg;
  192.     PROCEDURE Deposit*;
  193.         VAR m: Model; v: View;
  194.     BEGIN
  195.         NEW(m);
  196.         NEW(v); v.InitModel(m);
  197.         Views.Deposit(v)
  198.     END Deposit;
  199. END ObxGraphs.
  200. TextControllers.StdCtrlDesc
  201. TextControllers.ControllerDesc
  202. Containers.ControllerDesc
  203. Controllers.ControllerDesc
  204. TextRulers.StdRulerDesc
  205. TextRulers.RulerDesc
  206. TextRulers.StdStyleDesc
  207. TextRulers.StyleDesc
  208. TextRulers.AttributesDesc
  209. Helvetica
  210. Documents.ControllerDesc
  211.